home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / evaltp5.zip / EVAL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  4KB  |  163 lines
  1. unit Eval;
  2. interface
  3.  
  4.   function ExpValue (ExpLine : string; var Error : boolean) : real;
  5.  
  6. implementation
  7.  
  8.   function ExpValue (ExpLine : string; var Error : boolean) : real;
  9.   var
  10.     Index            : integer;
  11.     Ltr              : char;
  12.     NextLtr          : char;
  13.     Token            : char;
  14.     TokenValue       : real;
  15.  
  16.     procedure GetLtr;
  17.     begin {GetLtr}
  18.       Ltr := NextLtr;
  19.       if Index < length (ExpLine) then begin
  20.         Index := succ (Index);
  21.         NextLtr := ExpLine [Index];
  22.       end else begin
  23.         NextLtr := '%';
  24.       end;
  25.     end;
  26.  
  27.     procedure GetToken;
  28.       procedure GetNum;
  29.         var
  30.           Str : string;
  31.           E   : integer;
  32.       begin
  33.         Str := '0'+Ltr; {Avoids problems if first char is '.'}
  34.         while NextLtr in ['0'..'9'] do begin
  35.           GetLtr;
  36.           Str := Str + Ltr;
  37.         end; {while}
  38.         if NextLtr = '.' then begin
  39.           GetLtr;
  40.           Str := Str + Ltr;
  41.           while NextLtr in ['0'..'9'] do begin
  42.             GetLtr;
  43.             Str := Str + Ltr;
  44.           end; {while}
  45.           Str := Str + '0'; {Avoids problems if last char is '.'}
  46.         end;
  47.         val (Str,TokenValue,E);
  48.         Error := E <> 0;
  49.       end;
  50.  
  51.     begin {GetToken}
  52.       GetLtr;
  53.       while Ltr = ' ' do GetLtr;
  54.       if Ltr in ['0'..'9','.'] then begin
  55.         GetNum;
  56.         Token := '#';
  57.       end else begin
  58.         Token := Ltr;
  59.       end;
  60.     end;
  61.  
  62. function Expression : real;
  63.   var
  64.     IExp             : real;
  65.  
  66.     function Term : real;
  67.     var
  68.       ITerm : real;
  69.       TFact : real;
  70.  
  71.       function Factor : real;
  72.       var
  73.         IFact : real;
  74.  
  75.       begin {Factor}
  76.         case Token of
  77.           '(' :
  78.             begin
  79.               GetToken;
  80.               IFact := Expression;
  81.               if Token <> ')' then Error := true;
  82.             end;
  83.           '#' :
  84.             begin
  85.               IFact := TokenValue;
  86.             end;
  87.           else
  88.             Error := true;
  89.         end;
  90.         Factor := IFact;
  91.         GetToken;
  92.       end;
  93.  
  94.     begin {Term}
  95.       if Token = '-' then begin
  96.         GetToken;
  97.         ITerm := -Factor;
  98.       end else begin
  99.         if Token = '+' then begin
  100.           GetToken;
  101.         end;
  102.         ITerm := Factor;
  103.       end;
  104.       if not Error then begin
  105.         while Token in ['*','/'] do begin
  106.           case Token of
  107.             '*' :
  108.               begin
  109.                 GetToken;
  110.                 ITerm := ITerm * Factor;
  111.               end;
  112.             '/' :
  113.               begin
  114.                 GetToken;
  115.                 TFact := Factor;
  116.                 if TFact <> 0 then begin
  117.                   ITerm := ITerm / TFact;
  118.                 end else begin
  119.                   Error := true;
  120.                 end;
  121.               end;
  122.           end; {case}
  123.         end; {while}
  124.       end; {if}
  125.       Term := ITerm;
  126.     end; {Term}
  127.  
  128.   begin {Expression}
  129.     IExp := Term;
  130.     if not Error then begin
  131.       while Token in ['+','-'] do begin
  132.         case Token of
  133.           '+' :
  134.             begin
  135.               GetToken;
  136.               IExp := IExp + Term;
  137.             end;
  138.           '-' :
  139.             begin
  140.               GetToken;
  141.               IExp := IExp - Term;
  142.             end;
  143.         end; {case}
  144.       end; {while}
  145.     end; {if}
  146.     Expression := IExp;
  147.   end; {Expression}
  148.  
  149.   begin {ExpValue};
  150.     Error := false;
  151.     Index := 0;
  152.     NextLtr := ' ';
  153.     GetLtr;
  154.     GetToken;
  155.     if Token = '%' then begin
  156.       ExpValue := 0.0;
  157.     end else begin
  158.       ExpValue := Expression;
  159.       if Token <> '%' then Error := true;
  160.     end;
  161.   end;
  162.  
  163. end.